C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.3
C---------------------------------------------------------
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.3
C---------------------------------------------------------
C ----------------------------------------------------------------------
C
C       O U T T X T   -   Output Fortran-77 character string text
C
 
        SUBROUTINE OUTTXT(TEXT,IOD)
        CHARACTER*(*) TEXT
        INTEGER IOD
 
        INTEGER I,L
 
        INTRINSIC INDEX
 
        EXTERNAL ZPUTCH,ZCHOUT
 
        L=1
 100    I=INDEX(TEXT(L:),'.')
        IF (I.EQ.0) THEN
            CALL ZCHOUT(TEXT(L:),IOD)
        ELSE
            IF (I.GT.1) CALL ZCHOUT(TEXT(L:L+I-2),IOD)
            CALL ZPUTCH('.',IOD)
            L=L+I
            IF (L.LE.LEN(TEXT)) GOTO 100
        END IF
 
        END
C ----------------------------------------------------------------------
C
C       O U T M S G   -   Output a line of Fortran-77 character string
C
 
        SUBROUTINE OUTMSG(TEXT,IOD)
        CHARACTER*(*) TEXT
        INTEGER IOD
 
        EXTERNAL PUTCH
 
        CALL OUTTXT(TEXT,IOD)
        CALL PUTCH(10,IOD)
 
        END
C ----------------------------------------------------------------------
C
C       C C O P Y   -   Copy a character array to another
C
 
        SUBROUTINE CCOPY(CA1,LGTH,CA2)
        CHARACTER CA1(*),CA2(*)
        INTEGER LGTH
 
        INTEGER I
 
        DO 100 I=1,LGTH
 100        CA2(I)=CA1(I)
 
        END
C ----------------------------------------------------------------------
C
C       I N S O U T   -   Output a statement to the scratch
C                         instrumentation file.
C
 
        SUBROUTINE INSOUT
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.3
C---------------------------------------------------------
        COMMON/TOKENS/TOKTYP,TOKLEN,TXTPTR,TOKEN,NTOKSS,ISTTXT,ISTPTR,
     +                MAXICH
        INTEGER TOKTYP(800),TOKLEN(800),TXTPTR(800),
     +          TOKEN,NTOKSS,ISTTXT(1322+800),ISTPTR(800),
     +          MAXICH
 
        SAVE /TOKENS/
 
C
C TOKTYP = array of token types for current statement
C TOKLEN = parallel array of lengths of associated text strings
C TXTPTR = parallel array of pointers into ISTMG character array of text
C TOKEN = Current token number within statement being processed
C NTOKSS = Number of tokens in statement
C ISTTXT = IST text of token as read in before being converted by ZTOKTX
C ISTPTR = parallel array (to TOKTYP) of pointers into ISTTXT
C MAXICH = Last character used in ISTTXT array
C
 
        CALL SENDTK(1,NTOKSS)
        CALL SEND
 
        END
C ----------------------------------------------------------------------
C
C       W R I T O K   -   Write a token to the annotated token stream
C
 
        SUBROUTINE WRITOK(TYPE,CHAR)
        INTEGER TYPE
        CHARACTER*(*) CHAR
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.3
C---------------------------------------------------------
        COMMON/IO/IODINS,IODSTS,IODSUM,IODSCR,TKIDES,TKODES
        INTEGER IODINS,IODSTS,IODSUM,IODSCR,TKIDES,TKODES
 
        SAVE /IO/
 
 
        INTEGER TEXT(134),LENGTH
 
        INTRINSIC LEN
 
        EXTERNAL ZFTOI,ZTOKWR
 
        LENGTH=LEN(CHAR)
        CALL ZFTOI(CHAR,1,LENGTH,TEXT,.FALSE.)
        CALL ZTOKWR(TYPE,LENGTH,TEXT,TKODES)
 
        END
C ----------------------------------------------------------------------
C
C       S E N D C H   -   Send a character string to the (instrumented)
C                         output buffer
C
 
        SUBROUTINE SENDCH(CH)
        CHARACTER*(*) CH
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.3
C---------------------------------------------------------
C                  CONTROL VARIABLES
      COMMON / CNTRLC  /    IERRG,       IFTYPG,      ITYPEG,
     *         IUNITG,      JERRG,       KERRG,       LABFLG,
     *         LINEG,       LTYPEG,      NBUFFG,      NTOKG,
     *         NTOK2G,      NTOK3G,      NTOK4G,      NCOMG,
     *         NCRTNG,      NDDICG,      NEDICG,      NLABG,
     *         NMASRG,      NMSEG,       NRDICG,      NRTNG,
     *         NSTMG,       NTREEG,      NTYPEG
 
        INTEGER IERRG,IFTYPG,ITYPEG,IUNITG,JERRG,KERRG,LABFLG,LINEG,
     +          LTYPEG,NBUFFG,NTOKG,NTOK2G,NTOK3G,NTOK4G,NCOMG,NCRTNG,
     +          NDDICG,NEDICG,NLABG,NMASRG,NMSEG,NRDICG,NRTNG,NSTMG,
     +          NTREEG,NTYPEG
 
        SAVE /CNTRLC/
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.3
C---------------------------------------------------------
C Character variables and arrays, except for dictionaries & VNAMEG
        INTEGER MAXCMG
        PARAMETER(MAXCMG=30)
        COMMON /CHARC/ IBUFFG,ICARDG,ICOMG,ISTMG,NAMEG
 
        CHARACTER IBUFFG(1326),ICARDG(72),ISTMG(1326)
        CHARACTER*6 NAMEG
        CHARACTER*72 ICOMG(MAXCMG)
 
        SAVE /CHARC/
 
        INTEGER I
 
        INTRINSIC LEN
 
        DO 100 I=1,LEN(CH)
            NBUFFG=NBUFFG+1
            IBUFFG(NBUFFG)=CH(I:I)
100     CONTINUE
 
        END
C ----------------------------------------------------------------------
C
C       S E N D T K   -   Send a string of tokens to the instr buffer
C
C       This routine also does the conversion of CALL ZQUIT/ERROR when
C       in TIE mode, as it is easiest done here.
C
 
        SUBROUTINE SENDTK(FROM,TO)
        INTEGER FROM,TO
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.3
C---------------------------------------------------------
C Character variables and arrays, except for dictionaries & VNAMEG
        INTEGER MAXCMG
        PARAMETER(MAXCMG=30)
        COMMON /CHARC/ IBUFFG,ICARDG,ICOMG,ISTMG,NAMEG
 
        CHARACTER IBUFFG(1326),ICARDG(72),ISTMG(1326)
        CHARACTER*6 NAMEG
        CHARACTER*72 ICOMG(MAXCMG)
 
        SAVE /CHARC/
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.3
C---------------------------------------------------------
C                  CONTROL VARIABLES
      COMMON / CNTRLC  /    IERRG,       IFTYPG,      ITYPEG,
     *         IUNITG,      JERRG,       KERRG,       LABFLG,
     *         LINEG,       LTYPEG,      NBUFFG,      NTOKG,
     *         NTOK2G,      NTOK3G,      NTOK4G,      NCOMG,
     *         NCRTNG,      NDDICG,      NEDICG,      NLABG,
     *         NMASRG,      NMSEG,       NRDICG,      NRTNG,
     *         NSTMG,       NTREEG,      NTYPEG
 
        INTEGER IERRG,IFTYPG,ITYPEG,IUNITG,JERRG,KERRG,LABFLG,LINEG,
     +          LTYPEG,NBUFFG,NTOKG,NTOK2G,NTOK3G,NTOK4G,NCOMG,NCRTNG,
     +          NDDICG,NEDICG,NLABG,NMASRG,NMSEG,NRDICG,NRTNG,NSTMG,
     +          NTREEG,NTYPEG
 
        SAVE /CNTRLC/
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.3
C---------------------------------------------------------
C                  LOGICAL VARIABLES
      COMMON / LOGIC   /    ARITHG,      ASSRTG,      BLKDTG,
     *         CARD1G,      CGOTOG,      ENTRYG,      EXECG,
     *         HISTG,       IEOFG,       IFDOG,       INSRTG,
     *         MAING,       SEGMTG,      STOPG,       TRACEG,
     *         TREEG
      LOGICAL  ARITHG,      ASSRTG,      BLKDTG,      CARD1G,
     *         CGOTOG,      ENTRYG,      EXECG,       HISTG,
     *         IEOFG,       IFDOG,       INSRTG,      MAING,
     *         SEGMTG,      STOPG,       TRACEG,      TREEG
 
        SAVE /LOGIC/
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.3
C---------------------------------------------------------
C Option Settings
        COMMON /OPTSC/ INHSTG,INTRAG,ITHSTG,ITLSTG,ITTRAG,MCIRCG,
     +                 MTREQG,TIEG,ITRUNG
 
        INTEGER INHSTG,INTRAG,ITHSTG,ITLSTG,ITTRAG,MCIRCG,MTREQG,
     +          ITRUNG
        LOGICAL TIEG
 
        SAVE /OPTSC/
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.3
C---------------------------------------------------------
        COMMON/TOKENS/TOKTYP,TOKLEN,TXTPTR,TOKEN,NTOKSS,ISTTXT,ISTPTR,
     +                MAXICH
        INTEGER TOKTYP(800),TOKLEN(800),TXTPTR(800),
     +          TOKEN,NTOKSS,ISTTXT(1322+800),ISTPTR(800),
     +          MAXICH
 
        SAVE /TOKENS/
 
C
C TOKTYP = array of token types for current statement
C TOKLEN = parallel array of lengths of associated text strings
C TXTPTR = parallel array of pointers into ISTMG character array of text
C TOKEN = Current token number within statement being processed
C NTOKSS = Number of tokens in statement
C ISTTXT = IST text of token as read in before being converted by ZTOKTX
C ISTPTR = parallel array (to TOKTYP) of pointers into ISTTXT
C MAXICH = Last character used in ISTTXT array
C
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.3
C---------------------------------------------------------
        COMMON/ANVNAM/VNAMEG
        CHARACTER*5 VNAMEG
        SAVE/ANVNAM/
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.4
C---------------------------------------------------------
C
C  TKLAST = LAST TOKEN NUMBER
C
      INTEGER TZEOF ,TASSIG,TBACKS,TBLOCK,TCALL ,TCLOSE,TCOMMO,TCONTI,
     +        TDATA ,TDO   ,TDIMEN,TELSE ,TELSIF,TEND  ,TENDFI,TENDIF,
     +        TENTRY,TEQUIV,TEXTER,TFUNCT,TFORMA,TGOTO ,TIF   ,TIMPLI,
     +        TINQUI,TINTRI,TOPEN ,TPARAM,TPAUSE,TPRINT,TPROGR,TREAD ,
     +        TRETUR,TREWIN,TSAVE ,TSTOP ,TSUBRO,TTHEN ,TTO   ,TWRITE,
     +        TINTEG,TREAL ,TDOUBL,TCOMPL,TLOGIC,TCHARA,TDCMPL,TCOMMA,
     +        TEQUAL,TCOLON,TLPARN,TRPARN,TLE   ,TLT   ,TEQ   ,TNE   ,
     +        TGE   ,TGT   ,TAND  ,TOR   ,TEQV  ,TNEQV ,TNOT  ,TSTAR ,
     +        TDSTAR,TPLUS ,TMINUS,TSLASH,TCNCAT,TDCNST,TLCNST,TRCNST,
     +        TPCNST,TCCNST,THCNST,TNAME ,TFIELD,TSCALE,TZEOS ,TCMMNT,
     +        TFMTKD,TENDKD,TERRKD,TKLAST
      PARAMETER (TZEOF = 1,TASSIG= 2,TBACKS= 3,TBLOCK= 4,TCALL = 5,
     +           TCLOSE= 6,TCOMMO= 7,TCONTI= 8,TDATA = 9,TDO   =10,
     +           TDIMEN=11,TELSE =12,TELSIF=13,TEND  =14,TENDFI=15,
     +           TENDIF=16,TENTRY=17,TEQUIV=18,TEXTER=19,TFUNCT=20,
     +           TFORMA=21,TGOTO =22,TIF   =23,TIMPLI=24,TINQUI=25,
     +           TINTRI=26,TOPEN =27,TPARAM=28,TPAUSE=29,TPRINT=30,
     +           TPROGR=31,TREAD =32,TRETUR=33,TREWIN=34,TSAVE =35,
     +           TSTOP =36,TSUBRO=37,TTHEN =38,TTO   =39,TWRITE=40,
     +           TINTEG=41,TREAL =42,TDOUBL=43,TCOMPL=44,TLOGIC=45,
     +           TCHARA=46,TDCMPL=47,TCOMMA=48,TEQUAL=49,TCOLON=50,
     +           TLPARN=51,TRPARN=52,TLE   =53,TLT   =54,TEQ   =55,
     +           TNE   =56,TGE   =57,TGT   =58,TAND  =59,TOR   =60,
     +           TEQV  =61,TNEQV =62,TNOT  =63,TSTAR =64,TDSTAR=65,
     +           TPLUS =66,TMINUS=67,TSLASH=68,TCNCAT=69,TDCNST=70,
     +           TLCNST=71,TRCNST=72,TPCNST=73,TCCNST=74,THCNST=75,
     +           TNAME =76,TFIELD=77,TSCALE=78,TZEOS =79,TCMMNT=80,
     +           TFMTKD=81,TENDKD=82,TERRKD=83,TKLAST=83)
 
 
        INTEGER BUFF(134),STATUS,I,J,FIRST
        CHARACTER*6 NAMEL
        LOGICAL TEST
 
        CHARACTER*6 NAME
 
        INTEGER LENGTH,ZTOKTX
        CHARACTER ZCITOC
        EXTERNAL LENGTH,ZCITOC,ZTOKTX
 
C
C Special handling for possible labels on first line
C
        IF (FROM.EQ.1 .AND. TOKTYP(FROM).EQ.TDCNST) THEN
            FIRST=2
            DO 20 I=1,TOKLEN(1)
 20             IBUFFG(I)=ZCITOC(ISTTXT(ISTPTR(1)+I-1),IBUFFG(I))
            DO 40 I=TOKLEN(1)+1,6
 40             IBUFFG(I)=' '
        ELSE IF (NBUFFG.LT.7) THEN
            FIRST=FROM
            DO 60 I=1,6
 60             IBUFFG(I)=' '
        ELSE
            FIRST=FROM
        END IF
        NBUFFG=MAX(NBUFFG,6)
C
C Now output the ordinary stuff (if any)
C
        DO 200 I=FIRST,TO
C First check the token against ZQUIT and ERROR if in TIE mode
            TEST=TOKTYP(I).EQ.TNAME .AND. I.GT.FIRST .AND. TIEG
            IF (TEST) THEN
                NAMEL=NAME(I)
                TEST=(NAMEL.EQ.'ZQUIT' .OR. NAMEL.EQ.'ERROR' .OR.
     +                NAMEL.EQ.'ZEXIT' .OR.
     +                (TRACEG .AND. NAMEL.EQ.'ZINIT')) .AND.
     +                TOKTYP(I-1).EQ.TCALL
                IF (TEST) THEN
                    IF (NAMEL.EQ.'ZQUIT') THEN
                        CALL SENDCH('R'//VNAMEG)
                    ELSE IF (NAMEL.EQ.'ERROR') THEN
                        CALL SENDCH('E'//VNAMEG)
                    ELSE IF (NAMEL.EQ.'ZEXIT') THEN
                        CALL SENDCH('W'//VNAMEG)
                        IF (TRACEG .AND. ITTRAG.NE.1 .AND.
     +                      ITTRAG.NE.3) CALL ERROR(
     +'Cannot handle ZEXIT when TRACE-ing to a file')
                    ELSE IF (NAMEL.EQ.'ZINIT') THEN
                        CALL SENDCH('X'//VNAMEG)
                    END IF
                END IF
            END IF
            IF (.NOT.TEST) THEN
                STATUS=ZTOKTX(TOKTYP(I),TOKLEN(I),ISTTXT(ISTPTR(I)),
     +                        BUFF)
                DO 100 J=1,LENGTH(BUFF)
                    NBUFFG=NBUFFG+1
 100                IBUFFG(NBUFFG)=ZCITOC(BUFF(J),IBUFFG(NBUFFG))
            END IF
 200    CONTINUE
 
        END
C ----------------------------------------------------------------------
C
C       S E N D I   -   Send an integer to the instrumented buffer
C
 
        SUBROUTINE SENDI(INT)
        INTEGER INT
 
        CHARACTER*5 STRING
        INTEGER I
 
        WRITE(STRING,9000) INT
        I=0
 100    I=I+1
        IF (STRING(I:I).EQ.' ') GOTO 100
        CALL SENDCH(STRING(I:))
 
9000    FORMAT(SS,I5)
        END
C ----------------------------------------------------------------------
C
C       S E N D   -   Send the instrumented output buffer to the file
C
 
        SUBROUTINE SEND
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.3
C---------------------------------------------------------
        COMMON/IO/IODINS,IODSTS,IODSUM,IODSCR,TKIDES,TKODES
        INTEGER IODINS,IODSTS,IODSUM,IODSCR,TKIDES,TKODES
 
        SAVE /IO/
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.3
C---------------------------------------------------------
C Character variables and arrays, except for dictionaries & VNAMEG
        INTEGER MAXCMG
        PARAMETER(MAXCMG=30)
        COMMON /CHARC/ IBUFFG,ICARDG,ICOMG,ISTMG,NAMEG
 
        CHARACTER IBUFFG(1326),ICARDG(72),ISTMG(1326)
        CHARACTER*6 NAMEG
        CHARACTER*72 ICOMG(MAXCMG)
 
        SAVE /CHARC/
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.3
C---------------------------------------------------------
C                  CONTROL VARIABLES
      COMMON / CNTRLC  /    IERRG,       IFTYPG,      ITYPEG,
     *         IUNITG,      JERRG,       KERRG,       LABFLG,
     *         LINEG,       LTYPEG,      NBUFFG,      NTOKG,
     *         NTOK2G,      NTOK3G,      NTOK4G,      NCOMG,
     *         NCRTNG,      NDDICG,      NEDICG,      NLABG,
     *         NMASRG,      NMSEG,       NRDICG,      NRTNG,
     *         NSTMG,       NTREEG,      NTYPEG
 
        INTEGER IERRG,IFTYPG,ITYPEG,IUNITG,JERRG,KERRG,LABFLG,LINEG,
     +          LTYPEG,NBUFFG,NTOKG,NTOK2G,NTOK3G,NTOK4G,NCOMG,NCRTNG,
     +          NDDICG,NEDICG,NLABG,NMASRG,NMSEG,NRDICG,NRTNG,NSTMG,
     +          NTREEG,NTYPEG
 
        SAVE /CNTRLC/
 
 
        INTEGER I
        CHARACTER LINE1*72,LINE*72,LYNE(72)
        EQUIVALENCE (LINE1,IBUFFG),(LINE,LYNE)
 
        IF (NBUFFG.LT.72) THEN
            CALL OUTMSG(LINE1(1:NBUFFG),IODSCR)
        ELSE
            CALL OUTMSG(LINE1,IODSCR)
            DO 100 I=73,NBUFFG,66
                LINE='     +'
                CALL CCOPY(IBUFFG(I),MIN(66,NBUFFG-I+1),LYNE(7))
                CALL OUTMSG(LINE,IODSCR)
 100        CONTINUE
        END IF
        NBUFFG=0
        LINE1=' '
 
        END
C ----------------------------------------------------------------------
C
C       U N L A B L   -   Remove the label token from a line
C
 
        SUBROUTINE UNLABL
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.3
C---------------------------------------------------------
        COMMON/TOKENS/TOKTYP,TOKLEN,TXTPTR,TOKEN,NTOKSS,ISTTXT,ISTPTR,
     +                MAXICH
        INTEGER TOKTYP(800),TOKLEN(800),TXTPTR(800),
     +          TOKEN,NTOKSS,ISTTXT(1322+800),ISTPTR(800),
     +          MAXICH
 
        SAVE /TOKENS/
 
C
C TOKTYP = array of token types for current statement
C TOKLEN = parallel array of lengths of associated text strings
C TXTPTR = parallel array of pointers into ISTMG character array of text
C TOKEN = Current token number within statement being processed
C NTOKSS = Number of tokens in statement
C ISTTXT = IST text of token as read in before being converted by ZTOKTX
C ISTPTR = parallel array (to TOKTYP) of pointers into ISTTXT
C MAXICH = Last character used in ISTTXT array
C
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.4
C---------------------------------------------------------
C
C  TKLAST = LAST TOKEN NUMBER
C
      INTEGER TZEOF ,TASSIG,TBACKS,TBLOCK,TCALL ,TCLOSE,TCOMMO,TCONTI,
     +        TDATA ,TDO   ,TDIMEN,TELSE ,TELSIF,TEND  ,TENDFI,TENDIF,
     +        TENTRY,TEQUIV,TEXTER,TFUNCT,TFORMA,TGOTO ,TIF   ,TIMPLI,
     +        TINQUI,TINTRI,TOPEN ,TPARAM,TPAUSE,TPRINT,TPROGR,TREAD ,
     +        TRETUR,TREWIN,TSAVE ,TSTOP ,TSUBRO,TTHEN ,TTO   ,TWRITE,
     +        TINTEG,TREAL ,TDOUBL,TCOMPL,TLOGIC,TCHARA,TDCMPL,TCOMMA,
     +        TEQUAL,TCOLON,TLPARN,TRPARN,TLE   ,TLT   ,TEQ   ,TNE   ,
     +        TGE   ,TGT   ,TAND  ,TOR   ,TEQV  ,TNEQV ,TNOT  ,TSTAR ,
     +        TDSTAR,TPLUS ,TMINUS,TSLASH,TCNCAT,TDCNST,TLCNST,TRCNST,
     +        TPCNST,TCCNST,THCNST,TNAME ,TFIELD,TSCALE,TZEOS ,TCMMNT,
     +        TFMTKD,TENDKD,TERRKD,TKLAST
      PARAMETER (TZEOF = 1,TASSIG= 2,TBACKS= 3,TBLOCK= 4,TCALL = 5,
     +           TCLOSE= 6,TCOMMO= 7,TCONTI= 8,TDATA = 9,TDO   =10,
     +           TDIMEN=11,TELSE =12,TELSIF=13,TEND  =14,TENDFI=15,
     +           TENDIF=16,TENTRY=17,TEQUIV=18,TEXTER=19,TFUNCT=20,
     +           TFORMA=21,TGOTO =22,TIF   =23,TIMPLI=24,TINQUI=25,
     +           TINTRI=26,TOPEN =27,TPARAM=28,TPAUSE=29,TPRINT=30,
     +           TPROGR=31,TREAD =32,TRETUR=33,TREWIN=34,TSAVE =35,
     +           TSTOP =36,TSUBRO=37,TTHEN =38,TTO   =39,TWRITE=40,
     +           TINTEG=41,TREAL =42,TDOUBL=43,TCOMPL=44,TLOGIC=45,
     +           TCHARA=46,TDCMPL=47,TCOMMA=48,TEQUAL=49,TCOLON=50,
     +           TLPARN=51,TRPARN=52,TLE   =53,TLT   =54,TEQ   =55,
     +           TNE   =56,TGE   =57,TGT   =58,TAND  =59,TOR   =60,
     +           TEQV  =61,TNEQV =62,TNOT  =63,TSTAR =64,TDSTAR=65,
     +           TPLUS =66,TMINUS=67,TSLASH=68,TCNCAT=69,TDCNST=70,
     +           TLCNST=71,TRCNST=72,TPCNST=73,TCCNST=74,THCNST=75,
     +           TNAME =76,TFIELD=77,TSCALE=78,TZEOS =79,TCMMNT=80,
     +           TFMTKD=81,TENDKD=82,TERRKD=83,TKLAST=83)
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.3
C---------------------------------------------------------
C                  CONTROL VARIABLES
      COMMON / CNTRLC  /    IERRG,       IFTYPG,      ITYPEG,
     *         IUNITG,      JERRG,       KERRG,       LABFLG,
     *         LINEG,       LTYPEG,      NBUFFG,      NTOKG,
     *         NTOK2G,      NTOK3G,      NTOK4G,      NCOMG,
     *         NCRTNG,      NDDICG,      NEDICG,      NLABG,
     *         NMASRG,      NMSEG,       NRDICG,      NRTNG,
     *         NSTMG,       NTREEG,      NTYPEG
 
        INTEGER IERRG,IFTYPG,ITYPEG,IUNITG,JERRG,KERRG,LABFLG,LINEG,
     +          LTYPEG,NBUFFG,NTOKG,NTOK2G,NTOK3G,NTOK4G,NCOMG,NCRTNG,
     +          NDDICG,NEDICG,NLABG,NMASRG,NMSEG,NRDICG,NRTNG,NSTMG,
     +          NTREEG,NTYPEG
 
        SAVE /CNTRLC/
 
 
        INTEGER I
 
        IF (TOKTYP(1).EQ.TDCNST) THEN
            DO 100 I=2,NTOKSS
                TOKTYP(I-1)=TOKTYP(I)
                TOKLEN(I-1)=TOKLEN(I)
                TXTPTR(I-1)=TXTPTR(I)
                ISTPTR(I-1)=ISTPTR(I)
 100        CONTINUE
            IF (NTOKG.GT.0) NTOKG=NTOKG-1
            IF (NTOK2G.GT.0) NTOK2G=NTOK2G-1
            IF (NTOK3G.GT.0) NTOK3G=NTOK3G-1
            IF (NTOK4G.GT.0) NTOK4G=NTOK4G-1
            NTOKSS=NTOKSS-1
        END IF
 
        END
C ----------------------------------------------------------------------
C
C       N A M E   -   Return the name of a TNAME token as a char string
C
 
        CHARACTER*6 FUNCTION NAME(TOKNUM)
        INTEGER TOKNUM
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.4
C---------------------------------------------------------
C
C  TKLAST = LAST TOKEN NUMBER
C
      INTEGER TZEOF ,TASSIG,TBACKS,TBLOCK,TCALL ,TCLOSE,TCOMMO,TCONTI,
     +        TDATA ,TDO   ,TDIMEN,TELSE ,TELSIF,TEND  ,TENDFI,TENDIF,
     +        TENTRY,TEQUIV,TEXTER,TFUNCT,TFORMA,TGOTO ,TIF   ,TIMPLI,
     +        TINQUI,TINTRI,TOPEN ,TPARAM,TPAUSE,TPRINT,TPROGR,TREAD ,
     +        TRETUR,TREWIN,TSAVE ,TSTOP ,TSUBRO,TTHEN ,TTO   ,TWRITE,
     +        TINTEG,TREAL ,TDOUBL,TCOMPL,TLOGIC,TCHARA,TDCMPL,TCOMMA,
     +        TEQUAL,TCOLON,TLPARN,TRPARN,TLE   ,TLT   ,TEQ   ,TNE   ,
     +        TGE   ,TGT   ,TAND  ,TOR   ,TEQV  ,TNEQV ,TNOT  ,TSTAR ,
     +        TDSTAR,TPLUS ,TMINUS,TSLASH,TCNCAT,TDCNST,TLCNST,TRCNST,
     +        TPCNST,TCCNST,THCNST,TNAME ,TFIELD,TSCALE,TZEOS ,TCMMNT,
     +        TFMTKD,TENDKD,TERRKD,TKLAST
      PARAMETER (TZEOF = 1,TASSIG= 2,TBACKS= 3,TBLOCK= 4,TCALL = 5,
     +           TCLOSE= 6,TCOMMO= 7,TCONTI= 8,TDATA = 9,TDO   =10,
     +           TDIMEN=11,TELSE =12,TELSIF=13,TEND  =14,TENDFI=15,
     +           TENDIF=16,TENTRY=17,TEQUIV=18,TEXTER=19,TFUNCT=20,
     +           TFORMA=21,TGOTO =22,TIF   =23,TIMPLI=24,TINQUI=25,
     +           TINTRI=26,TOPEN =27,TPARAM=28,TPAUSE=29,TPRINT=30,
     +           TPROGR=31,TREAD =32,TRETUR=33,TREWIN=34,TSAVE =35,
     +           TSTOP =36,TSUBRO=37,TTHEN =38,TTO   =39,TWRITE=40,
     +           TINTEG=41,TREAL =42,TDOUBL=43,TCOMPL=44,TLOGIC=45,
     +           TCHARA=46,TDCMPL=47,TCOMMA=48,TEQUAL=49,TCOLON=50,
     +           TLPARN=51,TRPARN=52,TLE   =53,TLT   =54,TEQ   =55,
     +           TNE   =56,TGE   =57,TGT   =58,TAND  =59,TOR   =60,
     +           TEQV  =61,TNEQV =62,TNOT  =63,TSTAR =64,TDSTAR=65,
     +           TPLUS =66,TMINUS=67,TSLASH=68,TCNCAT=69,TDCNST=70,
     +           TLCNST=71,TRCNST=72,TPCNST=73,TCCNST=74,THCNST=75,
     +           TNAME =76,TFIELD=77,TSCALE=78,TZEOS =79,TCMMNT=80,
     +           TFMTKD=81,TENDKD=82,TERRKD=83,TKLAST=83)
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.3
C---------------------------------------------------------
        COMMON/TOKENS/TOKTYP,TOKLEN,TXTPTR,TOKEN,NTOKSS,ISTTXT,ISTPTR,
     +                MAXICH
        INTEGER TOKTYP(800),TOKLEN(800),TXTPTR(800),
     +          TOKEN,NTOKSS,ISTTXT(1322+800),ISTPTR(800),
     +          MAXICH
 
        SAVE /TOKENS/
 
C
C TOKTYP = array of token types for current statement
C TOKLEN = parallel array of lengths of associated text strings
C TXTPTR = parallel array of pointers into ISTMG character array of text
C TOKEN = Current token number within statement being processed
C NTOKSS = Number of tokens in statement
C ISTTXT = IST text of token as read in before being converted by ZTOKTX
C ISTPTR = parallel array (to TOKTYP) of pointers into ISTTXT
C MAXICH = Last character used in ISTTXT array
C
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.3
C---------------------------------------------------------
C Character variables and arrays, except for dictionaries & VNAMEG
        INTEGER MAXCMG
        PARAMETER(MAXCMG=30)
        COMMON /CHARC/ IBUFFG,ICARDG,ICOMG,ISTMG,NAMEG
 
        CHARACTER IBUFFG(1326),ICARDG(72),ISTMG(1326)
        CHARACTER*6 NAMEG
        CHARACTER*72 ICOMG(MAXCMG)
 
        SAVE /CHARC/
 
        INTEGER I
 
        INTRINSIC MIN
 
        EXTERNAL ERROR
 
        NAME=' '
        IF (TOKTYP(TOKNUM).NE.TNAME) CALL ERROR('Invalid NAME call')
        DO 100 I=1,MIN(6,TOKLEN(TOKNUM))
 100        NAME(I:I)=ISTMG(TXTPTR(TOKNUM)+I-1)
 
        END
C ----------------------------------------------------------------------
C
C       O U T Z F I   -   Output zero-filled integer
C
 
        SUBROUTINE OUTZFI(NUMBER,PLACES,IOD)
        INTEGER NUMBER,PLACES,IOD
 
        INTEGER BUFF(134)
 
        EXTERNAL ZITOCP
 
        CALL ZITOCP(NUMBER,BUFF,PLACES,48)
        CALL PUTLIN(BUFF,IOD)
 
        END
C ----------------------------------------------------------------------
C
C       S T R I P L   -   Return length of character string with
C                         trailing spaces stripped.
C
 
        INTEGER FUNCTION STRIPL(STRING)
        CHARACTER*(*)STRING
 
        INTRINSIC LEN
 
        STRIPL=LEN(STRING)
 
 100    IF (STRING(STRIPL:STRIPL).EQ.' ' .AND. STRIPL.GT.1) THEN
            STRIPL=STRIPL-1
            GOTO 100
        END IF
 
        END
